perm filename MOVE.FAI[NEW,LCS]15 blob
sn#502589 filedate 1980-04-19 generic text, type T, neo UTF8
00100 TITLE MOVE
00200 ENTRY GETPTS,MOVIT,COPYIT,STFCH,DELETE
00300 ; ENTRY SLEND,POSIT,NOTAIL
00400 EXTERNAL LOOP,RTLINE,DL,DPY,DPYNEW,.COMM.,XRN,KJY,PTR,POSI
00500 EXTERNAL SCM,AMOD,RMOD,RINP,DPTR,LIMIT,OUTLIM
00600
00700 K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00800
00900 ; SUBROUTINE GETPTS
01000 ; DIMENSION N(500),NP(500)
01100 ; COMMON/XRN/RN(4000) /KJY/ K,J
01200 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
01300 ; 1/PTR/PWDS(250),ITEM,LL,I,IX
01400 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
01500 ; 1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
01600
01700 GETPTS: 0 ;CALL GETPTS(N)
01800 SETZ J, ; J=0
01900 SETZ K, ; K=0
02000 MOVE JJ2,POSI+=8
02100 MOVE R2,.COMM.
02200 MOVE X,@(16)
02300 SOS X
02400 MOVEI M,PTR ; DO 1 M=1,ITEM
02500 ADDI M,(X)
02600 G1: AOJ X,
02700 MOVE L,(M)
02800 MOVEI R,XRN(L) ;L=PWDS(M)
02900 MOVE 1,1(R) ;RN(L+2)
03000 CAML R2,[=8.0] ;IF R2.GE.8 LOOK AT ALL STAVES
03100 JRST GZ
03200 CAME R2,1
03300 JRST GX
03400 GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
03500 JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
03600 CAME A,(R)
03700 JRST GX
03800 ; CHECK CODE NUM
03900 G9: MOVE A,2(R) ;IF(R6.NE.RY)GO TO 1
04000 CAMG A,.COMM.+6 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
04100 CAMGE A,.COMM.+5 ;R4
04200 JRST G2
04300
04400 CAMLE JJ2,X
04500 MOVE JJ2,X ;IF(M.LT.JJ2)JJ2=M
04600 AOJ J,
04700 ; IN LIMITS?
04800 MOVEI A,RINP+=499(J) ;J=J+1
04900 MOVEI 0,(L)
05000 AOJ K, ;K=K+1
05100 MOVEI 1,RINP+=849(K)
05200 MOVEM 0,(1)
05300 ADDI 0,3 ;N(J)=L+3
05400 MOVEM 0,RINP+=499(J)
05500 ; NP IS FOR USE IN JUSTIFY ROUTINE
05600 G2: MOVE RY,(R) ;2 IF(RY.EQ.2)GO TO GRST
05700 CAMN RY,[2.0] ;IF(RY.LT.4)GO TO 1
05800 JRST GRST
05900 CAML RY,[=4.0]
06000 CAMLE RY,[=7.0]
06100 JRST GX ;IF(RY.GT.7)GO TO 1
06200 ; TWO-ENDED ITEM?
06300 MOVE RZ,-1(R) ;RZ=RN(L)
06400 ; WD CNT
06500 KIFIX RY,RY
06600 XCT TBL-4(RY) ; NEXT REPLACES THE ABOVE.
06700 JRST G5
06800 JRST GX
06900 TBL: JRST G4
07000 JRST G5
07100 JRST G6
07200 CAMG RZ,[4.0]
07300
07400 G4: CAMG RZ,[=3.0] ;7 IF(RZ.GT.3)GO TO 5
07500 JRST GX
07600 JRST G5 ;GO TO 1
07700 GRST: MOVE RZ,-1(R) ;FOR 'CENTERED' RESTS
07800 JRST G8
07900 G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
08000 JRST G8
08100 SKIPL 6(R) ;IF(R7)GO TO 8
08200 SKIPN =9(R) ;IF(R10.EQ.0)GO TO 8
08300 JRST G8 ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
08400 SKIPG A,7(R) ;IGNORE P8 IF IT IS 0 OR -
08500 JRST G8
08600 CAMG A,.COMM.+6
08700 CAMGE A,.COMM.+5
08800 JRST G8
08900 CAMLE JJ2,X
09000 MOVE JJ2,X
09100 AOJ J,
09200 ; IN LIMITS?
09300 MOVEI 0,=8(L) ;J=J+1
09400 MOVEM 0,RINP+=499(J)
09500 G8: CAML RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
09600 SKIPG A,8(R) ; R9 IF(R9.LE.0)GO TO G5
09700 JRST G5
09800 CAME RY,[2.0] ;IF(RY.EQ.2)GO TO GRST2 (NEW REST CENTERING)
09900 SKIPE 7(R) ; R8 USE R9 IF R9<0 AND (R8≠0 OR R7<0)
10000 JRST GRST2
10100 SKIPL 6(R) ; R7
10200 JRST G5
10300 GRST2: CAMG A,.COMM.+6
10400 CAMGE A,.COMM.+5 ;R4
10500 JRST G5
10600
10700 CAMLE JJ2,X
10800 MOVE JJ2,X
10900 AOJ J, ;J=J+1
11000 ; IN LIMITS?
11100 MOVEI 0,=9(L)
11200 MOVEM 0,RINP+=499(J)
11300 G5: CAMN RY,[2.0] ;IF(RY.EQ.2)GO TO 1
11400 JRST GX
11500 MOVE A,5(R)
11600 CAMG A,.COMM.+6
11700 CAMGE A,.COMM.+5 ;R4
11800 JRST GX
11900
12000 CAMLE JJ2,X
12100 MOVE JJ2,X
12200 AOJ J,
12300 ; IN LIMITS?
12400 MOVEI 0,6(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
12500 MOVEM 0,RINP+=499(J)
12600 GX: CAMGE X,LIMIT+1 ;1 CONTINUE
12700 ;;GX: CAMGE X,PTR+=250 ;1 CONTINUE
12800 AOJA M,G1
12900 MOVEM JJ2,POSI+=8
13000 MOVEM J,KJY+1
13100 MOVEM K,KJY
13200 JRA 16,1(16)
13300
13400
13500 ; SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
13600 ; DIMENSION NP(1),RN(1)
13700 ; COMMON /KJY/ DONT,J
13800 MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
13900 MOVE R,@5(16)
14000 FSBR R,@4(16)
14100 MOVE RY,@3(16)
14200 FSBR RY,@2(16)
14300 FDVR R,RY
14400 ; MOVEI L,XRN+=2499 ; DO 1 K=1,J
14500 MOVEI L,@1(16) ; GET NP ARRAY LOC
14600 SETZ K,
14700 MOVE 0,@5(16) ; SET UP R9
14800 ;;M1: MOVE X,L ; L=NP(K)
14900 M1: MOVEI R2,@(16) ;RA=RN(L)
15000 ADD R2,(L)
15100 MOVEI RZ,(R2)
15200 MOVE R2,-1(R2)
15300 CAML R2,@2(16) ;IF(OUTLIM(R4,R5,RA))GO TO 1
15400 CAMLE R2,@3(16)
15500 JRST MX
15600 JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
15700 FSBR R2,@2(16)
15800 FMPR R2,R
15900 M2: FADR R2,@4(16) ; RN(L)=R8+RA
16000 MOVEM R2,-1(RZ)
16100 MX: AOJ K, ;1 CONTINUE
16200 CAMGE K,KJY+1
16300 AOJA L,M1
16400 JRA 16,6(16)
16500
16600 ;***** COPYIT
16700 ;; TITLE COPYIT
16800 ; SUBROUTINE COPYIT
16900 ; COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
17000 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
17100 ; 1/PTR/PWDS(250),ITEM,LL,I,IX
17200 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
17300 ; 1,(R6,RJQ(4)),(N,RN(2500))
17400 STFCH: 0
17500 SETO 13, ;FLAG FOR STFCH ROUTINE
17600 JRST .+3
17700
17800 COPYIT: 0
17900 SETZ 13, ;MAKE SURE IT'S 0
18000 SETZ 7, ;IM=ITEM
18100 MOVE 15,LIMIT+1 ; AC7 IS K-1
18200 ;; MOVE 15,PTR+=250 ; AC7 IS K-1
18300 SOJ 15, ;(ITEM-1)
18400 CP1: JSA 16,RTLINE ;DO 1 K=1,IM
18500 JUMP PTR(7) ;L=PWDS(K)
18600 JUMPL CPY ; IF(RTLINE(L))GO TO 1
18700 JSA 16,OUTLIM ;IF(OUTLIM(L,3))GO TO 1
18800 JUMP PTR(7)
18900 JUMP [3]
19000 JUMPL CPY
19100 MOVE 11,PTR(7) ; NOW L IS AC11
19200 MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
19300 JUMPE 10,CP3
19400 CAME 10,XRN(11)
19500 JRST CPY
19600 CP3: JUMPL 13,STF2 ; SKIP OVER FOR STFCH ROUTINE
19700 KIFIX 12,XRN-1(11) ;M=RN(L)+2
19800 ADDI 12,2
19900 JSA 16,LOOP ;CALL LOOP(0,M,1,I,L,RN)
20000 JUMP [0]
20100 JUMP 12
20200 JUMP [1]
20300 ;; JUMP PTR+=252
20400 JUMP LIMIT+3
20500 JUMP 11
20600 JUMP XRN
20700 AOS LIMIT+1 ;ITEM=ITEM+1
20800 ;; AOS PTR+=250 ;ITEM=ITEM+1
20900 ;; MOVE 13,PTR+=250
21000 MOVE 13,LIMIT+1
21100 MOVE 11,PTR-1(13) ;L=PWDS(ITEM)
21200 STF2: MOVE 14,.COMM.+=8 ;RN(L+2)=R7
21300 CAMG 14,[7.0] ;R7 > 7 = DON'T CHANGE STAFF NUM.
21400 MOVEM 14,XRN+1(11)
21500 JUMPGE 13,CP2
21600 MOVE 0,7
21700 AOJ
21800 CAMGE POSI+=8
21900 MOVEM POSI+=8 ; IF(K.LT.JJ2)JJ2=K
22000 JRST CPY
22100 CP2: CAMGE 13,POSI+=8 ;IF(ITEM.LT.JJ2)JJ2=ITEM
22200 MOVEM 13,POSI+=8
22300 AOJ 12, ;I=I+M+1
22400 ADD 12,LIMIT+3
22500 MOVEM 12,LIMIT+3
22600 MOVEM 12,PTR(13) ;PWDS(ITEM+1)=I
22700 CPY: CAMGE 7,15 ;1 CONTINUE
22800 AOJA 7,CP1
22900 JUMPL 13,.+3
23000 MOVE 7,.COMM.+=8 ;R2=R7
23100 MOVEM 7,.COMM. ;DOES THIS MATTER FOR STFCH}
23200 JRA 16,(16) ;END
23300
23400 ;SUBROUTINE STFCH
23500 ;INTEGER PWDS
23600 ;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
23700 ;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
23800 ;1/PTR/PWDS(250),ITEM,LL,I,IX
23900 ;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
24000 ;DO 1 K=1,ITEM
24100 ;L=PWDS(K)
24200 ;IF(RTLINE(L))GO TO 1
24300 ;IF(OUTLIM(L,3))GO TO 1
24400 ;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
24500 ;C DIDN'T MATCH THE CODE NUM.
24600 ;IF(JJ2)JJ2=K
24700 ;RN(L+2)=R7
24800 ;1 CONTINUE
24900 ;END
25000
25100 ;SUBROUTINE DELETE
25200 ;IMPLICIT INTEGER(A-Q,S-Z)
25300 ;COMMON/DL/X22,SAVER,NAME
25400 ;COMMON /XRN/RN(4000)
25500 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(15),R6,DEL,X,JY,K
25600 ;COMMON/PTR/PWDS(250),ITEM,L,I,IX
25700 ;COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
25800 DELETE: 0 ;EQUIVALENCE (ST2,ST(2))
25900 MOVE 15,LIMIT+3
26000 MOVEM 15,LIMIT+4
26100 ;; MOVE 15,PTR+=252
26200 ;; MOVEM 15,PTR+=253
26300 MOVE 12,DPY+=4000 ;171 IX=I 15 IS IX
26400 KIFIX 14,XRN-1(12) ;L=RN(MEDIT)+3.0
26500 ADDI 14,3 ;AC14 IS L
26600 ; SIZE OF DELETION
26700 SUB 15,14 ;I=IX-L
26800 MOVEM 15,LIMIT+3
26900 ;; MOVEM 15,PTR+=252
27000 JSA 16,LOOP ;CALL LOOP(MEDIT,I,1,0,L,RN)
27100 JUMP DPY+=4000
27200 JUMP LIMIT+3
27300 ;; JUMP PTR+=252
27400 JUMP [1]
27500 JUMP [0]
27600 JUMP 14
27700 JUMP XRN
27800 MOVE 7,DL ;JY=WDS(X22+1)-WDS(X22)
27900 MOVE 13,DPTR(7)
28000 ;; MOVE 13,DPY+=4000(7)
28100 ;; SUB 13,DPY+=3999(7) ;JY IS 13, X22 IS 7
28200 SUB 13,DPTR-1(7) ;JY IS 13, X22 IS 7
28300 MOVEI 10,2
28400 ADD 10,DPTR-1(7) ;WDS(X22)+2
28500 MOVE 15,LIMIT+1 ;15 IS ITEM (X)
28600 JSA 16,LOOP ;CALL LOOP(WDS(X22)+2,WDS(X),1,0,JY,ST)
28700 JUMP 10
28800 JUMP DPTR-1(15)
28900 ;; JUMP DPY+=3999(15)
29000 JUMP [1]
29100 JUMP [0]
29200 JUMP 13
29300 JUMP DPY
29400 MOVE 12,7 ;K=X22
29500 DELE: MOVE 11,12 ;194 N=K+1
29600 AOJ 11, ;N IS 11 K IS 12
29700 MOVE 2,DPTR(11) ;WDS(N)=WDS(N+1)-JY
29800 SUB 2,13
29900 MOVEM 2,DPTR-1(11)
30000 MOVE 2,PTR-1(11) ;PWDS(K)=PWDS(N)-L
30100 SUB 2,14
30200 MOVEM 2,PTR-1(12)
30300 MOVE 12,11 ;K=N
30400 CAMGE 12,15 ;IF(K.LT.X)GO TO 194
30500 JRST DELE ; ABOVE RESHUFFLES POINTER ARRAYS. X=ITEM+1
30600 SOS LIMIT+1 ;ITEM=ITEM-1
30700 MOVE 2,LIMIT+1
30800 CAMLE 7,LIMIT+1 ;IF(X22.GT.ITEM)X22=ITEM
30900 MOVEM 2,DL
31000 MOVEM 2,.COMM.+2 ;J2=ITEM
31100 SOS LIMIT+1 ;ITEM=ITEM-1
31200 MOVE 2,DPTR-1(2) ;ST2=WDS(J2)
31300 MOVEM 2,DPY+1
31400 JSA 16,DPYNEW ;271 CALL DPYNEW
31500 JRA 16,(16)
31600
31700 ;SLEND: 0 ; SUBROUTINE SLEND
31800 ; MOVE 8,[8.0] ;INTEGER PWDS
31900 ; MOVE 7,SCM+=80 ;C TO FIND END POINTS OF STAVES
32000 ; MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
32100 ;; 1 DMAX,UMAX,AA,JMAX,X,Y,BB,RNX(1982)
32200 ;; 1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
32300 ; SETZ 5, ;DO 1 K=1,ITEM
32400 ;SLN1: MOVE 6,PTR(5) ;L=PWDS(K)
32500 ; ;IF(RN(L+1).NE.8)GO TO 1
32600 ; CAMN 8,XRN(6) ;C FOUND A STAFF ;IF(RN(L+2).NE.STAFF)GO TO 1
32700 ; CAME 7,XRN+1(6) ;C GOT THE RIGHT ONE
32800 ; JRST SLN1X ;IF(IT)GO TO 2
32900 ; SKIPGE RMOD+=10 ;POS=202
33000 ; JRST SLN2 ;C NOW CHECK LEFT SIDE OF STAFF
33100 ; MOVSI 15,210624 ;[202.0] ;IF(RN(L).LT.4)RETURN
33200 ; CAML 4,XRN-1(6) ;P6 WASN'T MENTIONED - SO IT =200
33300 ; JRST SLN3
33400 ; ;POS=RN(L+6)+2
33500 ; MOVE 15,XRN+5(6) ;IF(POS.EQ.2)POS=202
33600 ; FADR 15,[2.0] ;RETURN
33700 ; CAMN 15,[2.0] ;2 POS=RN(L+3)-2.3
33800 ; MOVSI 15,210624 ;[202.0] ;RETURN
33900 ; JRST SLN3 ;1 CONTINUE
34000 ;SLN2: MOVE 15,XRN+2(6) ;END
34100 ; FSBR 15,[2.3]
34200 ;SLN3: MOVEM 15,RMOD+=11
34300 ; JRA 16,(16)
34400 ;SLN1X: AOS 5
34500 ; CAMGE 5,LIMIT+1
34600 ; JRST SLN1
34700 ; SKIPLE RMOD+=11 ;IF(POS.LE.0)RETURN
34800 ; JRST SLN2-2 ;POS=202 (IN CASE THERE IS NO STAFF)
34900 ; JRA 16,(16) ;END
35000
35100 ;POSIT: 0 ; FUNCTION POSIT(V)
35200 ; MOVE 15,@(16) ; COMMON/XRN/RN(4000)
35300 ; SKIPGE 15 ; DIMENSION POSNT(0/82)
35400 ; MOVNS 15 ; EQUIVALENCE (POSNT,RN(3801))
35500 ; 1,(A,RN(3884)),(K,RN(3885))
35600 ; KIFIX 14,15 ; IF(V)V=-V
35700 ; REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
35800 ; JSA 16,AMOD ; K=V
35900 ; JUMP 15 ; A=POSNT(K)
36000 ; JUMP [1.0] ;POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
36100 ; TYPE /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
36200 ; MOVE 2,RINP+=851(14) ; END
36300 ; FSBR 2,RINP+=850(14)
36400 ; FMPR 0,2
36500 ; FADR 0,RINP+=850(14)
36600 ; JRA 16,1(16)
36700
36800 ;NOTAIL: 0 ;FUNCTION NOTAIL(X)
36900 ; SETZ ;NOTAIL=0
37000 ; MOVM 2,@(16) ;X=ABS(X)
37100 ; CAML 2,[0.56] ;IF(X.LT..56.OR.X.EQ..75)RETURN
37200 ; CAMN 2,[0.75]
37300 ; JRA 16,1(16)
37400 ; CAME 2,[0.875] ;IF(X.EQ..875.OR.X.EQ..6)RETURN (8.. OR 10. )
37500 ; CAMN 2,[0.6]
37600 ; JRA 16,1(16)
37700 ; SETO ;NOTAIL=-1
37800 ; JRA 16,1(16)
37900 END